home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / math / pi / source.txt < prev   
Encoding:
Text File  |  1996-01-26  |  14.7 KB  |  374 lines
  1.     
  2.     Dim CalculatingPi As Integer  ' toggle true/false whether calc'ing pi
  3.     
  4.     '
  5.     '   Infinite Sums Formulas:
  6.     '
  7.     '       Pi = 1/1 - 1/3 + 1/5 - 1/7 + 1/9 - 1/11 . . . = 4 / Pi
  8.     '
  9.     '       Pi = 1/1^2 + 1/2^2 + 1/3^2 +1/4^2 + 1/5^2 . . . = (Pi^2) / 6
  10.     '
  11.     '
  12.     '   ArcTangent Formulas:
  13.     '
  14.     '       Pi = 4 * Atn(1)
  15.     '
  16.     '       Euler's Formula:
  17.     '           Pi = 20 * Atn(1/7) + 8 * Atn(3/79)
  18.     '
  19.     '       Gauss's Formula:
  20.     '           Pi = 48 * Atn(1/18) + 32 * Atn(1/57) - 20 * Atn(1/239)
  21.     '
  22.     '       Machin's Formula:
  23.     '           Pi = 16 * Atn(1/5) - 4 * Atn(1/239)
  24.     '
  25.     '
  26.     '       Power Series Expansion for ArcTangent:
  27.     '           Atn(X) = X - X^3 /3 + X^5 /5 - X^7 /7 + X^9 /9 . . .
  28.     '
  29.     '
  30.     '
  31.     '   Ramanujan's Formulas:
  32.     '
  33.     '            1          1103   27493  1  1*3   53883  1*3  1*3*5*7
  34.     '       -----------  =  ---- + -----  -  --- + -----  ---  ------- + . . .
  35.     '       2*pi*Sqr(2)     99^2   99^6   2  4^2   99^10  2*4  4^2+8^2
  36.     '
  37.     '
  38.     '       Elliptic Integral Formula:
  39.     '
  40.     '           1/pi = [ sqrt(8) / 9801 ] * sum { (4n)! * (1103+26390n) /
  41.     '                  [(n!)^4 * 396^(4n) ] }      (n=0,1,2,... )
  42.     
  43.  
  44. Sub CalculateButton_Click ()
  45.  
  46.     If CalculatingPi = False Then
  47.         CalculatePi
  48.     Else
  49.         End
  50.     End If
  51.  
  52. End Sub
  53.  
  54. Sub CalculatePi ()
  55.     
  56.     
  57.     Dim TimeSpent As Double
  58.     TimeSpent = Timer
  59.     
  60.     OutputBox = "Initializing": DoEvents
  61.     CalculatingPi = True
  62.     CalculateButton.Caption = "Stop!"
  63.  
  64.     Dim X As Integer
  65.     Dim CarryPosition As Integer
  66.     '  to be used in subtraction routine below
  67.     
  68.     Dim NumberOfLoops As Integer
  69.     Dim LengthOfNumbers As Integer
  70.     '  variables to be passed to FindArcTangent sub
  71.  
  72.     LengthOfNumbers = TextBox_LengthOfNumbers + 3
  73.     '  add 3 extra places because last couple may not be accurate
  74.     NumberOfLoops = Int(2 / 3 * LengthOfNumbers)
  75.     '  each iteration should produce about 1 1/2 accurate places
  76.     
  77.     
  78.     '  all numbers needed to be super accurate in this program
  79.     '  are represented by arrays consisting of single character
  80.     '  length strings.  the 1 position contains the digit in the
  81.     '  number to the far left, and the >1 positions in the array
  82.     '  represent the numbers going to the right in the # from there
  83.     
  84.     ReDim ArcTangent5(1 To LengthOfNumbers) As String * 1
  85.     ReDim ArcTangent239(1 To LengthOfNumbers) As String * 1
  86.     '  arrays to be calculated by FindArcTangent sub
  87.     
  88.     ReDim MultipliedArcTangent5(1 To LengthOfNumbers + 1) As String * 1
  89.     ReDim MultipliedArcTangent239(1 To LengthOfNumbers + 1) As String * 1
  90.     '  arrays to be calculated by MultiplyArray sub
  91.     
  92.     
  93.     
  94.     '       Machin's Formula:
  95.     '           Pi = 16 * Atn(1/5) - 4 * Atn(1/239)
  96.  
  97.     OutputBox = "Calculating ArcTangent of 1/5": DoEvents
  98.     FindArcTangent 5, NumberOfLoops, LengthOfNumbers, ArcTangent5()
  99.     
  100.     OutputBox = "Calculating the ArcTangent of 1/239": DoEvents
  101.     FindArcTangent 239, NumberOfLoops, LengthOfNumbers, ArcTangent239()
  102.     
  103.     
  104.     OutputBox = "Multiplying ArcTan of 1/5 by 16": DoEvents
  105.     MultiplyArray ArcTangent5(), 16, MultipliedArcTangent5()
  106.  
  107.     OutputBox = "Multiplying ArcTan of 1/239 by 4": DoEvents
  108.     MultiplyArray ArcTangent239(), 4, MultipliedArcTangent239()
  109.  
  110.     
  111.     OutputBox = "Subtracting the Multiplied Arctangents": DoEvents
  112.     For X = LengthOfNumbers To 1 Step -1
  113.                       ' subtract MultipliedArcTangent239 array
  114.                       ' from MultipliedArcTangent5 array
  115.         If MultipliedArcTangent5(X) < MultipliedArcTangent239(X) Then
  116.                                                 '  do we need to carry?
  117.             CarryPosition = X - 1 ' start with 1st number to the left
  118.                   
  119.             Do Until MultipliedArcTangent5(CarryPosition) <> "0"
  120.                           ' find a non-zero number to borrow from
  121.                 MultipliedArcTangent5(CarryPosition) = "9"  'fill the other #'s
  122.                 CarryPosition = CarryPosition - 1         ' with 9's
  123.                                 ' go to the next number to the left
  124.             Loop   '  loop until finding a non-zero number
  125.              ' at end of loop, CarryPosition will be # to borrow from
  126.             MultipliedArcTangent5(CarryPosition) = CStr(CInt(MultipliedArcTangent5(CarryPosition)) - 1)
  127.                             ' decrease number carried from by one
  128.             MultipliedArcTangent5(X) = CStr((CInt(MultipliedArcTangent5(X)) + 10) - CInt(MultipliedArcTangent239(X)))
  129.           'add an extra ten (borrowed) to MultipliedArcTangent5 and subtract MultipliedArcTangent239
  130.         Else ' just simple subtraction if there isn't carrying
  131.         
  132.             MultipliedArcTangent5(X) = CStr(CInt(MultipliedArcTangent5(X)) - CInt(MultipliedArcTangent239(X)))
  133.            
  134.         End If
  135.  
  136.     DoEvents
  137.     Next X  ' loop to subtract entire MultipliedArcTangent239 array
  138.         
  139.     
  140.  
  141.     '  with the MultipliedArcTangent239 array subtracted from the
  142.     '  MultipliedArcTangent5 array, the MultipliedArcTangent5 array
  143.     '  should now be equal to pi
  144.  
  145.  
  146.     Dim PiValue As String
  147.     
  148.     Label(2) = "Pi = 3. + . . .": DoEvents
  149.     OutputBox = ""  ' clear text box
  150.     For X = 1 To LengthOfNumbers - 3  ' don't print the extra 3 numbers
  151.     '  dump the value of pi into the text box
  152.     '  the array does not include the "3."
  153.     '  the 3 was bumped out of the array in
  154.     '  the multiplication routine
  155.         
  156.         PiValue = PiValue & MultipliedArcTangent5(X)
  157.         If X Mod 5 = 0 Then
  158.         '  insert a space every 50 places for word wrapping
  159.             PiValue = PiValue & " "
  160.         End If
  161.     
  162.     Next X
  163.  
  164.     OutputBox = PiValue
  165.  
  166.     
  167.     MsgBox "Pi calculated to " & LengthOfNumbers - 3 & " decimal places." & Chr$(13) & "Completed " & NumberOfLoops & " iterations." & Chr$(13) & "Spent " & (Timer - TimeSpent) / 60 & " minutes calculating.", 64, "Calculations Complete"
  168.     CalculatingPi = False
  169.     CalculateButton.Caption = "Calculate!"
  170.  
  171. End Sub
  172.  
  173. '                   Received                 Received                  Received                    Calculated and Passed
  174. Sub FindArcTangent (ArcTanToFind As Integer, NumberOfLoops As Integer, LengthOfNumbers As Integer, ArcTangent() As String * 1)
  175.     
  176.     '  ArcTanToFind      reciprocal of number to find arctangent of
  177.     '  NumberOfLoops     set number of iterations
  178.     '  LengthOfNumbers   set length of numbers
  179.     '
  180.     '  Machin's Formula
  181.     '  Pi = 16 * Atn(1/5) - 4 * Atn(1/239)
  182.     '
  183.     '  Atn(X) = X - X^3 /3 + X^5 /5 - X^7 /7 + X^9 /9 . . .
  184.     
  185.     
  186.     Dim StartPos As Integer ' position to start division loops
  187.     Dim Sum As Long   ' keeps track of total and carrying in adding loops
  188.     Dim X As Integer  ' multiusage as counter in For...Next and Do loops
  189.     Dim Divisor As Long  ' keeps track of what the Answer is to be divided by
  190.     Dim Remainder As Long  ' remainder in the dividing loops
  191.     Dim CarryPosition As Long  ' keeps track of position when carrying
  192.     Dim DividedInto As Integer ' counts how many times # has divided into
  193.     ReDim Answer(1 To LengthOfNumbers) As String * 1
  194.     '  answer after being raised to a certain power, built on each loop
  195.     ReDim Divided(1 To LengthOfNumbers) As String * 1
  196.     '  the Answer after being divided by the divisor
  197.     
  198.     
  199.     StartPos = 1
  200.     
  201.     For X = 1 To LengthOfNumbers
  202.         ArcTangent(X) = "0"    '  change arrays from having
  203.         Divided(X) = "0"       '  nulls to having 0's
  204.         Answer(X) = "0"
  205.     Next X
  206.  
  207.     
  208.     Select Case ArcTanToFind
  209.         Case 5
  210.             ArcTangent(1) = "2"      '  final answer is .2 (1/5) so far
  211.         
  212.         Case 239
  213.             X = 1
  214. FillInNumbers:
  215.             If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
  216.             If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
  217.             If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
  218.             If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
  219.             If X <= LengthOfNumbers Then ArcTangent(X) = "8": X = X + 1
  220.             If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
  221.             If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
  222.                 '  final answer is .0041841 repeating (1/239) so far
  223.             If X <= LengthOfNumbers GoTo FillInNumbers
  224.                 '  fill in entire array with the repeating fraction
  225.     End Select
  226.     
  227.     
  228.     For X = 1 To LengthOfNumbers     '  answer will be the same as
  229.         Answer(X) = ArcTangent(X)    '  the final arctangent at this point
  230.     Next X
  231.     
  232.     
  233.     
  234.     Divisor = 3              '  start with the divisor being 3
  235.     
  236.     
  237.     Do Until (Divisor - 1) / 2 = NumberOfLoops + 1'  stops after formula
  238.                                 '  has been computed NumberOfLoops times
  239.     
  240.         For X = Int(StartPos) To LengthOfNumbers
  241.                                 '  loop to divide Answer array by #^2
  242.             Remainder = Remainder * 10 ' multiply by ten and add new number
  243.             Remainder = Remainder + CInt(Answer(X)) '  like bringing down
  244.                                        ' the next number in long division
  245.             Do Until Remainder < (ArcTanToFind ^ 2)' loop until # is smaller
  246.                 Remainder = Remainder - (ArcTanToFind ^ 2)'subtract and count
  247.                 DividedInto = DividedInto + 1 ' times it has gone into the #
  248.             Loop
  249.  
  250.             Answer(X) = CStr(DividedInto)  ' the answer of the long division
  251.             Divided(X) = Answer(X)    ' make a copy in the divided array
  252.             DividedInto = 0    ' clear for next loop
  253.     
  254.             DoEvents
  255.         Next X        '  loop for whole array
  256.  
  257.     
  258.         DoneDividing = 0  ' reset this for next iteration
  259.         Remainder = 0     ' clear variables for the next loop
  260.         DividedInto = 0
  261.     
  262.     
  263.         For X = Int(StartPos) To LengthOfNumbers
  264.                                 'loop to divide Divided array by Divisor
  265.             Remainder = Remainder * 10       '  same long division loop
  266.             Remainder = Remainder + CInt(Divided(X)) ' bring down number
  267.  
  268.             Do Until Remainder < Divisor        ' divide into remainder
  269.                 Remainder = Remainder - Divisor
  270.                 DividedInto = DividedInto + 1   ' count number of times
  271.             Loop
  272.  
  273.             Divided(X) = CStr(DividedInto)  '  put answer back into array
  274.             DividedInto = 0      ' clear variable for next loop
  275.     
  276.             DoEvents
  277.         Next X     '  do this for entire Divided array
  278.  
  279.         Remainder = 0     ' clear variables for the next loop
  280.         DividedInto = 0
  281.         
  282.         
  283.         If Divisor Mod 4 = 1 Then ' all answers to be added will be true
  284.             
  285.             For X = LengthOfNumbers To 1 Step -1
  286.                                  '  add Divided array to ArcTangent array
  287.                 Sum = Sum + CInt(Divided(X)) + CInt(ArcTangent(X))
  288.                                              '  add the two numbers together
  289.                 ArcTangent(X) = CStr(Sum Mod 10)
  290.                                  '  the answer will just be the ones' place
  291.                 Sum = Int(Sum / 10) '  divide the remainder by ten for
  292.                      '  the increasing place value and drop the ones' place
  293.                 DoEvents
  294.             Next X  '  loop for entire arrays
  295.         
  296.             Sum = 0  ' clear variable
  297.         
  298.         Else '  all answers to be subtracted will be false
  299.             
  300.             For X = LengthOfNumbers To 1 Step -1
  301.                               ' subtract Divided array from ArcTan array
  302.                 If ArcTangent(X) < Divided(X) Then '  do we need to carry?
  303.                 
  304.                     CarryPosition = X - 1 ' start with 1st number to the left
  305.                     
  306.                     Do Until ArcTangent(CarryPosition) <> "0"
  307.                                   ' find a non-zero number to borrow from
  308.                         ArcTangent(CarryPosition) = "9"  'fill the other #'s
  309.                         CarryPosition = CarryPosition - 1         ' with 9's
  310.                                         ' go to the next number to the left
  311.                     Loop   '  loop until finding a non-zero number
  312.                      ' at end of loop, CarryPosition will be # to borrow from
  313.                     ArcTangent(CarryPosition) = CStr(CInt(ArcTangent(CarryPosition)) - 1)
  314.                                     ' decrease number carried from by one
  315.                     ArcTangent(X) = CStr((CInt(ArcTangent(X)) + 10) - CInt(Divided(X)))
  316.                   'add an extra ten (borrowed) to ArcTan and subtract Divided
  317.                 Else ' just simple subtraction if there isn't carrying
  318.             
  319.                     ArcTangent(X) = CStr(CInt(ArcTangent(X)) - CInt(Divided(X)))
  320.             
  321.                 End If
  322.  
  323.                 DoEvents
  324.             Next X  ' loop to subtract entire Divided array
  325.         
  326.             CarryPosition = 0  '  clear variable
  327.         
  328.         End If
  329.  
  330.  
  331.         Divisor = Divisor + 2   ' each loop, power and divisor increase by 2
  332.     
  333.         OutputBox = "Calculating ArcTangent of 1/" & ArcTanToFind & ", Done with iteration " & (Divisor - 1) / 2
  334.         DoEvents
  335.     
  336.         StartPos = StartPos + 1.25
  337.     
  338.     Loop  '  loop NumberOfLoops times
  339.           '  each time ArcTangent gets more accurate
  340.  
  341.  
  342. End Sub
  343.  
  344. '                  Received                         Received                       Calculated and Passed
  345. Sub MultiplyArray (ArrayToMultiply() As String * 1, NumberToMultiplyBy As Integer, Answer() As String * 1)
  346.  
  347.     Dim Position As Integer  '  current position in array
  348.     Dim SmallAnswer As Integer  '  keeps track of "sub-answers" in the multiplication process
  349.     Dim NumberToCarry As Integer  '  keeps track of carrying
  350.     
  351.     For Position = TextBox_LengthOfNumbers + 3 To 1 Step -1
  352.         
  353.         SmallAnswer = (CInt(ArrayToMultiply(Position)) * NumberToMultiplyBy) + NumberToCarry
  354.         '  multiply the 2 numbers together and add the remainder
  355.         
  356.         Answer(Position) = Right$(CStr(SmallAnswer), 1)
  357.         '  add ones place of SmallAnswer to the whole answer
  358.  
  359.         If SmallAnswer < 10 Then  '  if greater than ten we will need
  360.             NumberToCarry = 0     '  to carry
  361.         Else
  362.             NumberToCarry = CInt(Left$(CStr(SmallAnswer), CInt(Len(CStr(SmallAnswer))) - 1))
  363.         End If
  364.         '  carry the Answer without the ones place
  365.         '  (everything is shifted to the right so it get divided by 10)
  366.  
  367.     
  368.     DoEvents
  369.     Next Position  ' go on to the next position (moving to the left)
  370.  
  371.  
  372. End Sub
  373.  
  374.